;(in-package :closer-common-lisp-user)

;;;;;;;;;;;;;;;;;;;;;;
; GLOBAL DEFINITIONS ;
;;;;;;;;;;;;;;;;;;;;;;
(defvar *device-address* (format nil "~D." (machine-instance)))
;(defvar *device-address* (machine-instance))
(defvar *device-port* 10244)
(defvar *object-id* 0)
; *current-actor* is initialised in the concurrency file.
; This is the default actor for objects.
(defvar *current-actor* nil)
(defvar *remote-objects* (make-hash-table :test #'equal))
(defvar *remote-references* (make-hash-table :test #'equal))
(defvar *screen-output* *standard-output*)

(defun debug-print (text object)
  (format *screen-output* "DEBUG. ~D: ~D~%" text object))

(defun generate-new-object-name ()
  ; (format nil "object-~d" (incf *object-id*))
  (format nil "object-~d-at-~D" (incf *object-id*) *device-address*))

;;;;;;;;;;;;;;;;;;;;
; REMOTE-REFERENCE ;
;;;;;;;;;;;;;;;;;;;;
(defclass remote-reference (value-object)
  ((address :initarg :address :reader remote-reference-address)
   (port :initarg :port :reader remote-reference-port)
   (actor-name :initarg :actor-name :reader remote-reference-actor-name)
   (object-name :initarg :object-name :reader remote-reference-object-name)))

;;;;;;;;;;;;;;;;;
; REMOTE-OBJECT ;
;;;;;;;;;;;;;;;;;
(defclass remote-object ()
  ((name :initarg :object-name :initform (generate-new-object-name) :reader remote-object-name)
   (actor :initarg :actor :initform *current-actor* :accessor remote-object-actor)))

(defmethod initialize-instance :after ((object remote-object) &key name)
  (setf (gethash (remote-object-name object) *remote-objects*) object))

(defun find-remote-object (name &optional (errorp t))
  (multiple-value-bind
      (object foundp)
      (gethash name *remote-objects*)
    (cond (foundp object)
          (errorp (error "Remote object named ~S not found." name)))))

(defun (setf find-remote-object) (object name &optional errorp)
  (declare (ignore errorp))
  (setf (gethash name *remote-objects*) object))

(defun make-remote-reference (object)
;  (assert (remote-object-name object)
;     ((remote-object-name object))
;  "Remote object ~S cannot be printed, because it does not have a name." object)
  (make-instance
   'remote-reference
   :address *device-address*
   :port *device-port*
   :actor-name (remote-object-name (remote-object-actor object))
   :object-name (remote-object-name object)))

(defun ensure-remote-reference (object)
  (or (gethash object *remote-references*)
      (setf (gethash object *remote-references*)
            (make-remote-reference object))))

(defun print-remote-object (object stream)
  (print (ensure-remote-reference object) stream))

(defmethod print-object ((object remote-object) stream)
  (if *print-readably*
      (print-remote-object object stream)
    (call-next-method)))

(defmethod update-instance-after-reading ((reference remote-reference))
  (if (on-this-machine-p reference)
    (find-remote-object (remote-reference-object-name reference))
    reference))

(defmethod on-this-machine-p ((reference remote-reference))
  (equal (remote-reference-address reference) *device-address*))

(defmethod reference-equal ((reference-1 remote-reference) (reference-2 remote-reference))
  (and
   (equal (remote-reference-address reference-1) (remote-reference-address reference-2))
   (equal (remote-reference-port reference-1) (remote-reference-port reference-2))
   (equal (remote-reference-actor-name reference-1) (remote-reference-actor-name reference-2))
   (equal (remote-reference-object-name reference-1) (remote-reference-object-name reference-2))))
